00100	C***** BEAMS,  MARKS,  XNOTE, BAUTO, UPDATE *******
00200		SUBROUTINE BEAMS
00300		COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
00325		1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
00362		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00380		1 /PTR/PWDS(250),ITEM,LL,IS,IX
00400		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00410		COMMON RJB,JAZ,CENTR,JBZ,RJQ(20),JQ(20)
00500		COMMON/SCX/RHY(4),JALPHA(19),JX,U,JZ,IRHY,JD,KA,KB,IZ
00600		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
00700		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00800		1 /STF/RSTFAC(8),RSTJC
00900		DIMENSION R(10,80)
01100		EQUIVALENCE (R,RN(3001)),(STEM,RN(2999))
01200		DATA BX/25./,BY/.5/,DFAC/4./,CURV/1./
01250	C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
01300	
01310		INVT=-1
01332		IF(MODE.EQ.3)GO TO 25
01420		IF(REND.NE.0)GO TO 25
01425		REND=3
01500	25	DO 1500 K=1,72
01600		IF(INP(K).EQ.'B')GO TO 22
01700	C  B=AUTOMATIC BEAMS.
01800		IF(INP(K).NE.'*')GO TO 1500
01900	15	INP(72)='*'
02000		GO TO 500
02100	1500	IF(INP(K).EQ.ISEMI)GO TO 500
02110		GO TO 15
02200	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
02300	22	REREAD F78F,A,B
02400	C  TYPE '2B' OR '3B' FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
02500		IF(IREAD.NE.0)A=B
02600		A=A/2.
02700	C  '2'=1  '3'=1.5
02850		IF(STEM)STEM=0
02875	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
02900		K=0
03000		N=0
03100		J=0
03200		INP(72)='*'
03230	C  PICKS UP RHYTHM FROM TIME WHEN MODE=2 (NOW IT =4)
03300	122	K=K+1
03400		L=K
03500	222	C=ABS(V(K))
03540		IF(C.EQ.4./88.)GO TO 522
03580	C  CATCHES 88TH NOTES (GRACE NOTES)???
03600		IF(V(K).GT.0)GO TO 922
03700	1022	N=N+1
03800	C  SUBTRACTS NUMB. FOR REST.
03900		IF(C.GE.A)GO TO 1222
04000	1322	L=L+1
04100		GO TO 422
04200	1222	IF(AMOD(C,A).NE.0)GO TO 622
04300		IF(K-L.LE.1)GO TO 522
04400		L=L+1
04500		GO TO 722
04600	922	IF(C.EQ.A)GO TO 522
04700	422	IF(K.EQ.IRHY)GO TO 322
04800		K=K+1
04810		B=V(K)
04900		IF(B.NE.4./88.)C=C+ABS(B)
05000		IF(B)GO TO 1022
05100		IF(C.LT.A-.0001)GO TO 422
05175		IF(C.LT.A+.0001)GO TO 722
05250	C  .0001 FOR ROUNDOFF PROBLEMS
05325	1922	C=AMOD(C,A)
05400		IF(K-L.LE.1)GO TO 622
05475		CALL BAUTO(J,L,K-1,N)
05625	622	L=K
05700		IF(ABS(V(K)).GE.A.OR.C.EQ.0)L=L+1
05800		GO TO 422
05900	722	IF(K.EQ.L)GO TO 522
06000	1722	DO 1422 IT=L,K
06100	1422	IF(V(IT).GE.1)GO TO 1522
06200	C WON'T PUT BEAMS WHERE NOT LOGICAL.
06210		IF(V(L)+V(K).LT.A+.0001)CALL BAUTO(J,L,K,N)
06255	C  DOES ONLY DUPLES AT THIS POINT.
06400	522	IF(K.LT.IRHY)GO TO 122
06500	
06600	322	IF(J.EQ.0)RETURN
06700	C  NO BEAMS - SO GO BACK.
06800		DO 822 K=J+1,68
06850	C  USES ONLY 68 SLOTS IN 'V'
06900	822	V(K)=0
07000		J=0
07100		GO TO 27
07200	1522	IF(IT-1.GT.L)GO TO 1622
07300	1822	L=IT+1
07400		IF(L.LT.K)GO TO 1722
07500		GO TO 522
07600	1622	CALL BAUTO(J,L,IT-1,N)
07700		GO TO 1822
07800	C  ALL THIS ↑↑ FOR QUARTERS IN TRIPLE TIME UNITS!
07820	27	DO 26 L=1,50
07860	26	VX(L)=V(L)
07870	C  BECAUSE MODE 3 IS NOW ACCENTS, ETC.
07880		GO TO 511
07900	
08000	500	REREAD F78F,VX
08100		J=0
08200		IF(IREAD.NE.0)J=1
08300	511	J=J+1
08400		N=VX(J)
08500	C  SKIPS LINE #S.
08600		JMP=1
08700	505	L=0
08800		K=0
08900		POS=-10.
09000		IF(MODE.EQ.3)GO TO 5030
09100	C  MODE 3 IS FOR ACCENTS ETC.
09200		IF(N.GT.100)GO TO 161
09300	C  IZ=TOTAL # OF NOTES
09500		RN(8+IS)=0
09600		IT=0
09700	503	IF(N.GT.0)GO TO 5031
09800		IT=-1
09900		POS=-1.3
10000	C  -1= SLUR INTO 1ST NOTE.
10200	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
10300		GO TO 5060
10400	5031	IF(N.LE.80)GO TO 5030
10500	C  203 WILL BECOME 201 AT 61
10600		POS=202
10700		GO TO 550
10800	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
10900	5030	L=L+1
11000	502	K=K+1
11100		IF(R(1,K).NE.1.)GO TO 502
11200	C  IS IT A NOTE?
11300		P=R(2,K)
11400		IF(P.EQ.POS)GO TO 502
11500	C  SKIPS DBLSTPS
11600		POS=P
11700	506	IF(L.NE.N)GO TO 5030
11800	5060	IF(MODE.EQ.3)GO TO 30
11900	C  NOW SLUR STARTS
12000		IF(JMP)GO TO 504
12100	C  JMP=-1 MEANS END NOTE OF GROUP
12200		J=J+1
12300		NN=VX(J)
12310	CC	IF(MODE.NE.5.OR.STEM)GO TO 5061
12320	CC	M=R(5,K)-20.
12330	CC	IF((NN.AND.M.GE.0).OR.(M.AND.NN.GE.0))NN=-NN
12335		IF(STEM.OR.(MODE.EQ.4.AND.STEM.EQ.0))GO TO 5061
12340	C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
12350		A=19.-R(5,K)
12360		IF((NN.AND.A.GT.0).OR.(A.AND.NN.GT.0))NN=-NN
12400	5061	MK=N
12500		N=NN
12600		IF(N)N=-N
12700		M=K
12800		JA=2
12900		JB=4
13000		KN=K
13200		RB=0
13300		IF(MODE.EQ.4)GO TO 550
13310		IF(STEM.GE.0)NN=-NN
13320		IF(IT)GO TO 550
13360	C  IT=-1=SLUR INTO 1ST NOTE.
13400		A=XNOTE(K)
13500	C XNOTE IS AMOD(R(4,K),100.)
13600	C  SAVES LEVEL OF 1ST NOTE.
13700	504	RB=2
13800		B=AMOD(R(6,K),1.0)
13900		IF(B.GE.0.5)RB=4.
14000		IF(B.EQ.0.4)RB=6.
14100	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
14200		IF(NN)RB=-RB
14300	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
14400	550	RN(JA+IS)=POS
14500		RN(JB+IS)=XNOTE(K)+RB
14600		JA=6
14700		JB=5
14800	C  MK=# OF 1ST NOTE, N=END NOTE NOW
14900		JMP=-JMP
15000		IF(JMP.GT.0)GO TO 1503
15100	C  GO FIND RT. SIDE OF SLUR
15200		IF(N.LE.MK)N=MK+1
15300	C  PICKS UP TYPO ERRORS
15400		JK=0
15500		IF(R(7,K).GE.10)JK=-1
15600	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
15700		GO TO 503
15800	
15900	1503	RN(3+IS)=STAFF
16000		IF(MODE.EQ.4)GO TO 35
16100		RN(8+IS)=-1
16200		RN(1+IS)=8
16300		IF(IT)RN(4+IS)=RN(5+IS)
16400		NN=-NN
16500	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
16600		IF(MK.EQ.IRHY.OR.N.EQ.1)GO TO 61
16700		IF(((XNOTE(K).NE.A.OR.N-MK.GT.1).AND.IT.GE.0.
16800		1 ).OR.IT)GO TO 60
16900	C  .N. WAS .KQ. 12/73
17000	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
17100	61	C=9
17200		IF(JK)C=12
17300		IF(RN(6+IS)-RN(2+IS)-C*RSTJC)GO TO 65
17400		IF(IT)A=XNOTE(K)
17500		A=A+.7
17600		IF(NN.GT.0)A=A-1.4
17700	C  TO RAISE OR LOWER IT .5
17800		RN(4+IS)=A
17900		RN(5+IS)=A
18000		B=-2
18100		IF(JK)B=-3
18200	C  JK=-1 WHEN NOTE IS DOTTED.
18300	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
18400		RN(8+IS)=B
18500		GO TO 65
18600	161	J=J+1
18700		K=VX(J)
18800		M=N-100
18900	C  THIS WILL DIRECT STEMS ON NOTES M THROUGH K. IF -K,STEMS DN.
19000		NN=K
19100		IF(K)K=-K
19200	
19300	C  NEXT IS STEM INVERTER
19400	60	JB=1
19500		RB=10.
19600		IF(NN)GO TO 509
19700	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
19800		RB=-RB
19900		JB=2
20000	509	DO 507 L=M,K
20100		IF(R(1,L).NE.1.)GO TO 507
20200		JA=R(5,L)/10.
20400		IF(JA.NE.JB)GO TO 507
20405		R(5,L)=R(5,L)+RB
20410		INVT=0
20450	C**********************************************
20500	507	CONTINUE
20600		IF(N.GT.100)GO TO 514
20700	C  JUMP IF ONLY REVERSING STEMS.
20800		GO TO 200
20900	62	IF(NN)GO TO 64
21000		IF(A.EQ.DMAX)GO TO 65
21100		AA=B-DMAX
21200		GO TO 63
21300	65	AA=0
21400		GO TO 63
21500	64	IF(A.EQ.UMAX)GO TO 65
21600		AA=UMAX-B
21700	63	RA=RN(6+IS)
21800		RB=RN(2+IS)
21900		X=CURV+(RA-RB)/BX
22000		IF(AA.GT.0)X=X+AA*BY
22100		IF(NN.GT.0)X=-X
22200	510	RN(7+IS)=X
22220		IF(MODE.NE.4)GO TO 2514
22240		RN(9+IS)=0
22260		RN(10+IS)=0
22280		RN(IS+11)=-1
22290		CALL UPDATE(9)
22300		IF(JB)CALL BMX(RA)
22350		GO TO 514
22360	2514	CALL UPDATE(6)
22400	514	J=J+1
22500		N=VX(J)
22550		IF(N.GT.IRHY)N=0
22600		IF(N.NE.0)GO TO 505
22700		IF(J.LT.50)GO TO 514
22800	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
22900		IF(INP(72).NE.'*')GO TO  552
22905		IF(INVT)RETURN
22915		INVT=IS
22920		CALL NEWR
22925		IS=INVT
22990		RETURN
23000	552	IF(IREAD.NE.0)GO TO 3501
23100		CALL TYPE
23200		GO TO 25
23300	3501	READ(22,2501)J,INP
23380	C  TO READ MORE THAN 2 LINES.
23400		GO TO 25
23500	C  FOR 2ND LINE.
23600	2501	FORMAT(I,72A1)
23700	
23800	
24000	35	RA=10.
24100	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
24200		RN(1+IS)=9
24300		JMAX=0
24400		IF(N-MK.EQ.1)JMAX=-1
24500		DMAX=100.
24600		UMAX=-DMAX
24700	C  FOR AUTO. BEAMS
24800	
24900		JB=0
25000		DO 2 L=KN,K
25400	12	IF(R(1,L).NE.1.OR.R(5,L).LT.10.)GO TO 2
25500	C  SKIPS NON-NOTES AND DBLSTPS
25600		RB=R(4,L)
25700		IF(ABS(RB).GE.100)GO TO 2
25800	C  SKIPS GRACE NOTES
25900		IF(RB.GT.UMAX)UMAX=RB
26000		IF(RB.LT.DMAX)DMAX=RB
26100	C  FOR AUTO. BEAMS
26200		RB=AMOD(R(7,L),10.0)
26300	112	IF(RA.EQ.RB)GO TO 2
26400		JB=-1
26500	C   FLAG FOR MIXED NUM. OF BEAMS
26600		IF(RB.LT.RA.AND.RB.NE.0)RA=RB
26700	2	CONTINUE
26800	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
26900	C  ABOVE IS POS.2
27075		IF(STEM.EQ.0.AND.UMAX+DMAX.GE.14)NN=-1
27087	CXX	IF(STEM.GT.0)NN=10.-STEM
27100	C  SETS AUTO. BEAMS' STEM DIRECTION.
27200		X=10
27300		IF(NN)X=20
27400		X=X+RA
27500	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
27600	200	A=XNOTE(KN)
27700	C   A=NOTE 1.
27800		UMAX=A
27900		DMAX=A
28000	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
28100	103	DO 3 M=KN,K
28200		IF(R(1,M).NE.1.OR.ABS(R(4,M)).GE.100)GO TO 3
28300	C  SKIPS NON-NOTES
28400	7	Y=R(5,M)
28500		B=XNOTE(M)
28550		IF(STEM.GT.0)GO TO 55
28600	33	IF(NN.GT.0.)GO TO 5
28700	C  JUMP IF STEM UP
28800		IF(Y.GE.20..OR.Y.LT.10.)GO TO 55
28850		R(5,M)=Y+10.
28875		GO TO  551
29000	5	IF(Y.LT.20.)GO TO 55
29025		R(5,M)=Y-10.
29050	C************************
29100	C    STEM UP
29120	551	INVT=0
29200	55	IF(B.LT.UMAX)GO TO 13
29300		UMAX=B
29400		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
29500		UMAX=UMAX+1
29600		GO TO 3
29700	13	IF(B.GT.DMAX)GO TO 3
29800		DMAX=B
29900		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
30000		DMAX=DMAX-1
30100	3	CONTINUE
30200	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
30300	4	IF(MODE.EQ.5)GO TO 62
30400		AA=A
30500		BB=B
30600		C=1
30700		IF(X.LT.20.)GO TO 48
30800	C  JUMP IF STEM IS UP
30900		CALL EXCH(AA,BB)
31000		C=-C
31100		CALL EXCH(UMAX,DMAX)
31200	48	IF(AA.LT.BB)GO TO 45
31300		IF(UMAX.EQ.A)GO TO 46
31400	47	A=UMAX-C
31500		B=A
31600		GO TO 444
31700	46	IF(UMAX.GT.AA)GO TO 47
31800		GO TO 49
31900	45	IF(UMAX.NE.B)GO TO 47
32000	49	A=AA
32100		B=BB
32200		IF(X.GE.20)CALL EXCH(A,B)
32300	
32400	444	RN(3+IS)=STAFF 
32420	446	DIS=(RN(IS+6)-RN(IS+2))/DFAC
32460	C  FOR TILT LATER -- DFAC IS IN DATA
32560		IF(ABS(A-B).LT.DIS)GO TO 14
32570		C=C*DIS
32580	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
32600	C  LIMITS SLOPE OF BEAM
32700		IF(X.GE.20)GO TO 141
32800		IF(B.GT.A)GO TO 140
32900	142	B=A-C
33000		GO TO 14
33100	141	IF(B.GT.A)GO TO 142
33200	140	A=B-C
33300	14	RN(4+IS)=A
33400		RN(5+IS)=B
33500	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
33600		RN(6+IS)=R(2,K)
33700	C  ABOVE IS POS.2
33800		GO TO 510
33900	
34000	C   NEXT IS FOR ACCENTS AND OTHER MARKS
34100	
34200	30	CALL MARKS(RA)
34300		J=J+1
34400		IF(RA.EQ.99)RA=VX(J)
34500	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
34600	C    OF ACCENT WILL BE INVERTED.
34700		RB=R(6,K)
34800		B=10.
34900		IF(RA.EQ.6)RA=26.
35000	C TEMPORARY CHANGE FOR FERMATA*******
35100		IF(RA.GT.10.)RA=RA/10.
35200		A=ABS(AMOD(RB,1.))
35300		IF(A.EQ.0)GO TO 301
35400		IF(RA.GT.3)GO TO 303
35500		RB=FLOAT(IFIX(RB))
35600		RA=RA+A/10.
35700	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
35800		GO TO 301
35900	303	IF(A.LT..3)GO TO 302
36000		B=100.
36100		GO TO 301
36200	302	B=1000.
36300	301	IF(RB.LT.0)RA=-RA
36400		R(6,K)=RB+RA/B
36500		GO TO 514
36600	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
36700	C  NOTE#,ACCENT#/N,A/N,A*
36800		END
36900	
37000		FUNCTION XNOTE(J)
37100		COMMON/XRN/RN(4000)
37200		DIMENSION R(10,80)
37300		EQUIVALENCE (R,RN(3001))
37400		XNOTE=AMOD(R(4,J),100.)
37500		END
37600	
37700		SUBROUTINE BAUTO(J,L,K,N)
37800	C  FOR AUTOMATIC BEAMS.
37900		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
38000		J=J+2
38100		V(J-1)=L-N
38200		V(J)=K-N
38300		END
38400	
38500		SUBROUTINE UPDATE(I)
38600		COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
38700		RN(IS)=I
38800		IS=IS+I+3
39100		END